home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / telecom / 24 / games / makemaze.pas < prev    next >
Pascal/Delphi Source File  |  1986-06-19  |  7KB  |  207 lines
  1. PROGRAM MAZE_MAKER;    { V.1.0 last update 5/30/86 }
  2.                        { By Steve Pauley    }
  3.   CONST
  4.     {$I gemconst}
  5.  
  6.     Num_Size = 10;     { string size   }
  7.  
  8.  
  9.   TYPE
  10.     {$I gemtype}
  11.  
  12.   VAR
  13.        Maze_One      : ARRAY[ 1..81,1..49 ] OF Byte;    { maze 1 array }
  14.        X,Y,Z         : integer;
  15.        R_Num         : Integer;              { used by One_To_Four     }
  16.        X_Direct : ARRAY[ 1..5 ] OF Integer;  { look-up forward move }
  17.        Y_Direct : ARRAY[ 1..5 ] OF Integer;  { look-up forward move }
  18.        X_Back   : ARRAY[ 1..5 ] OF Integer;  { look-up move back }
  19.        Y_Back   : ARRAY[ 1..5 ] OF Integer;  { look-up move back }
  20.  
  21.  
  22.   {$I gemsubs}
  23.  
  24.  
  25.  
  26. FUNCTION random: Integer;       { returns a randon integer + or - }
  27.    XBIOS(17);
  28.  
  29.  
  30. PROCEDURE Set_Up;    { assign values for Direction look-up table }
  31. BEGIN
  32.    X_Direct[ 1 ] :=  0;  { forward x value }
  33.    X_Direct[ 2 ] :=  2;
  34.    X_Direct[ 3 ] :=  0;
  35.    X_Direct[ 4 ] := -2;
  36.    X_Direct[ 5 ] :=  0;
  37.  
  38.    Y_Direct[ 1 ] := -2;  { forward y value }
  39.    Y_Direct[ 2 ] :=  0;
  40.    Y_Direct[ 3 ] :=  2;
  41.    Y_Direct[ 4 ] :=  0;
  42.    Y_Direct[ 5 ] :=  0;
  43.  
  44.    X_Back[ 1 ]   :=  0;  { back-up x value }
  45.    X_Back[ 2 ]   := -2;
  46.    X_Back[ 3 ]   :=  0;
  47.    X_Back[ 4 ]   :=  2;
  48.    X_Back[ 5 ]   :=  0;
  49.  
  50.    Y_Back[ 1 ]   :=  2;  { back-up y value }
  51.    Y_Back[ 2 ]   :=  0;
  52.    Y_Back[ 3 ]   := -2;
  53.    Y_Back[ 4 ]   :=  0;
  54.    Y_Back[ 5 ]   :=  0;
  55. END;  { Set_Up }
  56.  
  57.  
  58. PROCEDURE One_To_Four;          { makes a random number from 1 - 4 }
  59. VAR
  60.    Num_Long     : Long_Integer;
  61.    Num_Short    : Integer;
  62. BEGIN
  63.    REPEAT
  64.       Num_Short  := random;
  65.       Num_Long   := ABS( Num_Short );
  66.       Num_Long   := Num_Long DIV 6554;
  67.       Num_Short  := INT( Num_Long );
  68.    UNTIL ( Num_Short > 0 ) AND ( Num_Short < 5 );
  69.    R_Num := Num_Short;
  70. END;  { of One_To_Four  }
  71.  
  72.  
  73. PROCEDURE Kolors;       { Set new colors in color registers }
  74. CONST
  75.    Zero=  0;     { values for color registers }
  76.    One =  150;
  77.    Two =  300;
  78.    Three= 400;
  79.    Four = 550;
  80.    Five = 650;
  81.    Six  = 800;
  82.    Seven= 900;
  83.    BEGIN
  84.       Set_Color( 0,Seven,Seven,Seven );  {  set background to black }
  85.       Set_Color( 1,Seven,Zero,Zero );  { set to red }
  86.       Set_Color( 2,Zero,Seven,Zero );  { set to Green }
  87.       Set_Color( 3,Zero,Zero,Seven );  { set to Blue }
  88.       Set_Color( 4,Seven,Two,Zero );
  89.       Set_Color( 5,Zero,Zero,Zero );
  90.       Set_Color( 6,Seven,Zero,Four );
  91.       Set_Color( 7,Six,One,Six );
  92.       Set_Color( 8,Four,One,Seven );
  93.       Set_Color( 9,Three,Three,Seven );
  94.       Set_Color( 10,Zero,Five,Five );
  95.       Set_Color( 11,Zero,Seven,Four );
  96.       Set_Color( 12,Four,Seven,Zero );
  97.       Set_Color( 13,Zero,Zero,Two );
  98.       Set_Color( 14,Two,Two,Six );
  99.       Set_Color( 15,Four,Four,Seven );
  100. END;  { of Kolors }
  101.  
  102.  
  103. PROCEDURE Clean_Screen;
  104. BEGIN
  105.    Draw_Mode( 1 );
  106.    Paint_Color( 0 );
  107.    Paint_Rect( 0,0,320,200 );
  108. END; { of Clean_Screen }
  109.  
  110.  
  111. PROCEDURE Make_Maze_One;
  112. VAR
  113.    D_Num,Rotate  :Integer;       { direction numbers }
  114.    LX,LY         :Integer;       { loop control var }
  115.    New_X,New_Y   :Integer;       { new location to check }
  116.    Half_X,Half_Y :Integer;       { halfway between X and New_X, Y and New_Y }
  117.  
  118. BEGIN
  119.    Draw_Mode( 1 );            { replace mode }
  120.    Paint_Color( 5 );          { maze wall color }
  121.    Paint_Rect( 0,0,319,190 ); { paint complete maze area wall color }
  122.    Paint_Color( 0 );          { black for path color }
  123.    FOR LX := 1 TO 81 DO       { store 255 in every element of array }
  124.    BEGIN
  125.       FOR LY := 1 TO 49 DO
  126.       BEGIN
  127.          Maze_One[ LX,LY ] := 255;
  128.       END;
  129.    END;
  130.    FOR LX := 1 TO 81 DO       { store 0 around outside edge of array }
  131.    BEGIN
  132.       Maze_One[ LX,1 ] := 0;
  133.       Maze_One[ Lx,49 ] := 0;
  134.    END;
  135.    FOR LY := 1 TO 49 DO
  136.    BEGIN
  137.       Maze_One[ 1,LY ] := 0;
  138.       Maze_One[ 81,LY ] := 0;
  139.    END;
  140.  
  141.    Maze_One[ 3,2 ] := 0;      { start location or hole in wall }
  142.    Paint_Rect( 3*4-8, 2*4-8, 6, 6 );
  143.    X := 3;                    { starting location of maze path }
  144.    Y := 3;
  145.    Maze_One[ X,Y ] := 5;      { start marker }
  146.    Paint_Rect( X*4-8, Y*4-8, 6, 6 );
  147.    D_Num := 3;                { start with down direction }
  148.  
  149.    REPEAT                     { maze calculating main loop }
  150.       One_To_Four;            { get a random number from 1 to 4 }
  151.       IF R_Num < 3 THEN Rotate := 1;  { direction rotate clock wise }
  152.       IF R_Num > 2 THEN Rotate := -1; { direction rotate counter clock wise }
  153.       One_To_Four;            { get a random number from 1 to 4 }
  154.       D_Num := R_Num;         { copy new random number to direction number }
  155.       REPEAT
  156.          D_Num := D_Num + Rotate ;       { rotate to new direction }
  157.          IF D_Num > 4 THEN D_Num := 1;   { make sure it is one of 4 ways }
  158.          IF D_Num < 1 THEN D_Num := 4;
  159.          New_X := X + X_Direct[ D_Num ]; { calculate next location to check }
  160.          New_Y := Y + Y_Direct[ D_Num ];
  161.          { if new location is open or we have tried all 4 ways, stop checking }
  162.       UNTIL ( D_Num = R_Num ) OR ( Maze_One[ New_X,New_Y ] = 255 );
  163.       IF Maze_One[ New_X,New_Y ] = 255 THEN    { new direction is unused }
  164.       BEGIN                                    { add new section to path }
  165.          Maze_One[ New_X,New_Y ] := D_Num;     { store direction marker }
  166.          Half_X := ( ( New_X+X ) DIV 2 );      { find wall between new ... }
  167.          Half_Y := ( ( New_Y+Y ) DIV 2 );      { location and old path  }
  168.          Maze_One[ Half_X,Half_Y ] := 0;       { and store a zero       }
  169.          { paint the new path }
  170.          Paint_Rect( New_X*4-8, New_Y*4-8, 6, 6 );
  171.          Paint_Rect( Half_X*4-8,Half_Y*4-8, 6, 6 );
  172.          X := New_X;   { update position pointers }
  173.          Y := New_Y;
  174.       END
  175.       ELSE BEGIN                       { no new path direction left open }
  176.          D_Num := Maze_One[ X,Y ];     { read old direction pointer }
  177.          Maze_One[ X,Y ] := 0;         { this path is deadend so erase marker }
  178.          X := X + X_Back[ D_Num ];     { move position pointer back to ...}
  179.          Y := Y + Y_Back[ D_Num ];     { previous location }
  180.       END;
  181.    UNTIL D_Num = 5;  { if we are back to start marker maze is finished }
  182.    Maze_One[ 79,48 ] := 0;      { start location or hole in wall }
  183.    Paint_Rect( 79*4-8, 48*4-8, 6, 6 );
  184.  
  185. END;  { of Make_Maze_One  }
  186.  
  187.  
  188. BEGIN    { PROGRAM }
  189.     IF Init_Gem >= 0 THEN
  190.       BEGIN
  191.         { start program here  }
  192.         Hide_Mouse;
  193.         Kolors;              { set all color registers }
  194.         Set_Up;              { assign values to direction arrays }
  195.         Clean_Screen;        { draw a big black square }
  196.         Draw_String( 0,198,'MAZE MAKER - by S. Pauley' );
  197.         Make_Maze_One;       { calculate and draw the first maze }
  198.         REPEAT
  199.            Draw_String( 0,198,'ALT & HELP to PRINT  -  OTHER KEYS EXIT' );
  200.         UNTIL Keypress;
  201.         Show_Mouse;
  202.         Set_Color( 0,950,950,950 );  { turn screen white before we stop }
  203.         Set_Color( 1,0,0,0 );  { turn mouse & text color back to black  }
  204.         Exit_Gem ;
  205.       END ;
  206. END.